perm filename SCN.F4[NEW,LCS] blob
sn#568812 filedate 1981-02-26 generic text, type T, neo UTF8
TITLE SCANR
ENTRY SCANR,LNEND,STFNUM
EXTERNAL SCN,SC,ALF,NALF,EXP3.2,SCX,SCM,RMOD,JCHAR,A2Z,MKX
ML←5 ↔ K←0 ↔ NNUM←14 ↔ ISKP←13 ↔ JJ←12 ↔ XMINUS←11 ↔ DECI←10
M←7 ↔ N←6 ↔ QQ←4 ↔ TRIP←3
DEFINE LTT<A2Z+=19> ↔ DEFINE LZ<A2Z+=25>
DEFINE LM <A2Z+=12> ↔ DEFINE LN<A2Z+=13> ↔ DEFINE LP <A2Z+=15>
DEFINE LL <A2Z+=11> ↔ DEFINE LR<A2Z+=17> ↔ DEFINE LBL <SCX+=11>
DEFINE LSL <MKX> ↔ DEFINE LST <SCX+=7 > ↔DEFINE LCM<SCX>
DEFINE LE <A2Z+4> ↔ DEFINE LC <A2Z+2> ↔ DEFINE LS <A2Z+=18>
DEFINE LPL<SCX+=6 > ↔DEFINE LMI<SCX+1> ↔ DEFINE LF <A2Z+5>
DEFINE LA <A2Z> ↔ DEFINE LI <A2Z+=8> ↔ DEFINE LW <A2Z+=22>
DEFINE JN <SC+=10> ↔ DEFINE DBST <SC+=11> ↔ DEFINE ISEMI <JCHAR+1>
DEFINE IXX <A2Z+=23> ↔ DEFINE MODE <SC+=70> ↔ DEFINE VX <SC+=16>
DEFINE LU <A2Z+=20> ↔ DEFINE LD <A2Z+3> ↔ DEFINE INP <ALF>
DEFINE REXP<SC+6> ↔DEFINE DOT<SCX+2> ↔ DEFINE VX4 <SC+=19>
IQ: BLOCK 12
C SUBRS. SCANR, NALF, EDIT, PRESCN
C ***** MSS SCANNER *************************
SUBROUTINE SCANR
DIMENSION IQ(10),LRUD(4)
COMMON/ALF/INP(72),ML
COMMON/SCN/LL,LR,LU,LD,LSL,LE,LC,LS,LF,LA,LI,LW
COMMON/SCX/JALPHA(30),J4,L,Y,K,RX,RZ,RA,J5 /JCHAR/IXX,ISEMI,JBLA,IG
COMMON /SC/J,L,MK
1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
EQUIVALENCE (IQ(1),VX(41)),(VX1,VX(1)),(VX2,VX(2)),(LDN,LRUD(4))
DATA LRUD/'L','R','U','D'/
C FOR LEFT, RIGHT, UP, DOWN, EDIT
MOVE ML,ALF+=72 ; 5 IS ML UNTIL RETURN
NNUM=-1
ISKP=0
JJ=0
XMINUS=1.
C LEAVES BLANK WHEN REST.
999 DECI=-1
M=0
2799 N=INP(ML)
899 ML=ML+1
781 IF(N.EQ.'/')N=ISEMI
C FOR MOTIVIC TRANFORMATIONS
IF(N.EQ.'*')GO TO 751
IF(N.EQ.ISEMI)GO TO 751
C '*' AND '/' ADDED ABOVE 4/18/73
IF(N.NE.IXX)GO TO 22
IF(JN)GO TO 22
IF(ISKP.EQ.0)GO TO 210
ML=ML-1
GO TO 202
22 IF(N.EQ.IBLA)GO TO 4702
IF(N.NE.',')GO TO 510
IF(ISKP)202,2799,2799
512 ML=ML+1
IF(INP(ML).EQ.ISEMI)GO TO 773
GO TO 512
C LRUD: ASCII/L /
C ASCII/R /
C ASCII/U /
C ASCII/D /
510 IF(JN.GE.0)GO TO 173
C SKIP(JN=+1) IF NOT COMING FROM 'EDIT'
JN=1
DO 702 K=1,4
702 IF(N.EQ.LRUD(K))GO TO 703
C FINDS L, R, U, D
IF(N.LE.IBLA)GO TO 899
C GO TO 703 IF REALLY A LETTER, ELSE MOVE UP POINTER
GO TO 899
703 JJ=JJ+1
C YOU CAN TYPE THE FULL WORD
IF(K.NE.4)GO TO 77
IF(INP(ML).EQ.'E')K=99
C 'DE'=DELETE
77 IF(N.EQ.'E')K=55
C 'E'= EDIT
IF(N.EQ.'C')K=2222
IF(N.EQ.IXX)K=222
C 'C'=COPY, 'X'=EXIT FROM EDIT MODE
VX(JJ)=K
704 IF(INP(ML).EQ.JBLA)GO TO 2799
IF(INP(ML).GT.0)GO TO 2799
C IF NEXT CHAR. IS A LETTER(NEG.), SKIP IT.
C PUT COMMA ERASER IN SCX.
ML=ML+1
C SO IT WILL SKIP 'D' AND 'EL' IN 'EDIT' AND 'DEL'
GO TO 704
173 K=NALF(N)
IF(N.GT.0)GO TO 1410
IF(K.EQ.18)GO TO 73
C JUMP IF A REST OR OTHER R'S
IF(MODE.EQ.2)GO TO 144
C ;YOU CAN TYPE 'S', ETC., FOR SIXTEENTH ETC., RHYTHM.
C ; JUMP IF NOT A LETTER
C notes = 1xyz.0 x=accidental, yz=note num., negative=chord note
C rest = 2xyz.0 z=0=ordinary, =1=invis., =2=whole, =3=repeat bar
C =4=down, =5=up, -2xyz=num. of meas. rest
C clefs = 3xyz.0 z=0=treble, =1=bass, =2=alto, =3=tenor, neg.=invis.
C use TRE,BAS,ALT,TEN for clefs with no change to note levels.(4,5,6,7)
C bars = 4xyz.0 z=num. of staves up, neg.=dbl.bar
C ksig = 17xyz.0 z=num. of accis., pos.=#, neg.=b, x=1 for naturals.
C meter = 18xyz.n xy=top num, zn=bottom num (DONE IN SCMSS)
C stem = 5xyz.0 YZ=10=stem up, =20=stem down
C staff = 5xyz.0 z=0=return to norm., =1=lower stf., =2=upper stf.
IF(K.LT.8)GO TO 15
C JUMP IF A POSSIBLE NOTE
IF(K.NE.11)GO TO 16
C JUMP IF NOT A KSIG
QQ=17000
CC**** NUM FOR KEY SIGS ***
18 N=INP(ML)
ML=ML+1
IF(N.EQ.IBLA)GO TO 18
IF(N.NE.'N')GO TO 200
C IS IT AN N? K3FN/ OR K2SN/ MAKES NATURALS
C IF NEXT CHAR='N' A 'NATURALS' KEY SIG.
QZ=100.
IF(QQ.LE.0)QZ=-QZ
QQ=QQ+QZ
GO TO 18
200 IF(N.EQ.'S')GO TO 18
IF(N.EQ.'+')GO TO 18
IF(N.EQ.ISEMI)GO TO 20
IF(N.EQ.'-')N='F'
IF(N.NE.'F')GO TO 18
19 A=NALF(N)
QQ=-QQ
C NEG. FOR FLATS
GO TO 18
C GO BACK AND LOOK AGAIN
20 IF(QQ.LT.0)QQ=QQ-A
IF(QQ.GT.0)QQ=QQ+A
CC VX(1)=(17000.+A)*XMINUS
VX(1)=QQ
C KSIG
GO TO 773
C NOW LOOK FOR 'I'
16 IF(K.NE.9)GO TO 2
VX(1)=22.
C FOR EDIT I21 ETC.
GO TO 2799
C NOW 'M'
2 IF(K.NE.13)GO TO 3
C; MOVSI 02,214764 ; ***** BARS =4000 ******
C MOVE 2,[4001.0] ; THE 1 IS FOR BAR ONE STAFF ONLY.
QZ=4001.
2002 JN=INP(ML)
IF(JN.EQ.LD)GO TO 3002
IF(JN.NE.'M')GO TO 23
VX(1)=VX(1)+1
ML=ML+1
GO TO 2002
C GO BACK AND LOOK FOR MORE M'S ML=ML+1
3002 ML=ML+1
C FOUND 'MDN' -- FOR DOUBLE BARS
JN=0
QZ=-QZ
C DBL BARS ARE NEG.
23 VX(1)=QZ
K=NALF(INP(ML))
IF(K.LE.0)GO TO 512
IF(K.GT.9)GO TO 512
C NO MORE THAN 8 STAVES UP ALLOWED.
K=K-1
C BECAUSE ORIG. NUM WAS 4001, NOT 4000
IF(JN.EQ.0)K=-K
C NEG. IF DBL BAR
VX(1)=VX(1)+K
C 'M2'= A BAR LINE UP 2 STAVES. ETC.
GO TO 512
3 IF(K.GT.16)GO TO 4
C JUMP IF NOT FOR 'PROXIMITY' MODE
NSWCH=K-15
GO TO 2799
C TO SWITCH ALWAYS USE OCT.# /PBF4/ /OE5/ P=PROXIMITY, O=ORDINARY
4 IF(K.NE.20)GO TO 21
C TRY AGAIN IF NOT A 'T'
IF(INP(ML).GT.0)GO TO 2799
C T12,8/ ETC. MAKES A METR, OR TIM SIG. POS NUMS AREN'T LETRS!
C MOVSI 02,214567 ; ***** CLEFS = 3000 ***** CODE 3.
QZ=3000.
IF(INP(ML).EQ.'E')QZ=QZ+3.
C TENOR CLEF =3003, TREBLE=3000
GO TO 4002
21 IF(K.NE.19)GO TO 2799
C NOT AN 'S'(STEM OR STAFF), UNKNOWN ITEM, SKIP IT.
KI=INP(ML)
C MOVE 2,INP-1(ML) ;10600 IF(INP(ML).EQ.LDN)VX(1)=5020.
C MOVE 03,[5000.0] ; SU UP=5010
QQ=0
IF(KI.EQ.'U')QQ=10.
C CAMN 2,LU FADR 3,[10.0]
IF(KI.EQ.'D')QQ=20.
C CAMN 2,LD FADR 3,[20.0] ; DOWN = 5020
IF(KI.EQ.'+')QQ=2.
C CAMN 2,LPL ;IF( .EQ.'+') S+=5002
C FADR 3,[2.0]
IF(KI.EQ.'-')QQ=1.
C CAMN 2,LMI ;IF( .EQ.'-') S-=5001
C FADR 3,[1.0] ; IF( .EQ.'0') S0=5000
C THESE ARE FOR S+, S-, S0; PUT NOTE ON OTHER STF.
VX(1)=5000.+QQ
C MOVEM 03,VX
GO TO 512
15 N=INP(ML)
IF(K.NE.2)GO TO 5
C CAIN K,2 ;IF(1ST LETR.NE.'B')GO TO S5
IF(N.NE.'A')GO TO 5
C JUMP IF NOT BASS CLEF
QZ=3001.
C MOVE 02,[3001.0] ;BASS CLEF=3001
4002 N=INP(ML+1)
C GET 3RD CHAR.
IF(N.EQ.' '.OR.N.EQ.'/'.OR.N.EQ.';')GO TO 5002
C IF 3RD CHAR IS SIGNIFICANT THEN SPECIAL CLEF
C 4,5,6,7 = 0,1,2,3 BUT NO INFLUENCE ON NOTE LEVEL
QZ=QZ+4.
ML=ML+1
5002 VX(1)=QZ
51 IF(XMINUS.LT.0)VX(1)=-VX(1)
C TYPE '-BA' FOR INVISIBLE BASS CLEF, ETC.
GO TO 512
5 IF(N.NE.'L')GO TO 6
C JUMP IF NOT ALTO CLEF
QZ=3002.0
GO TO 4002
6 K=K-2
C S6: SUBI 2 ; -2 BECAUSE MUSICAL ALPHABET STARTS WITH C
IF(K.LE.0)K=K+7
C SKIPG ADDI 7
NNUM=K
C MOVE NNUM,K ; K IS AC0
KQ=1000
C MOVEI QQ,=1000
K=1
IF(NNUM.GT.3)K=K+1
C FOUND A NOTE
IF(N.EQ.IXX)GO TO 5410
C FOR GX3/ ETC.
IF(N.NE.INP(ML))GO TO 66
C NO DOUBLE-LETTER ACCID. (FLAT)
IF(N.NE.INP(ML+1))GO TO 88
C NO TRIPLE-LETTER ACCID. (SHARP)
ML=ML+1
IF(N.NE.INP(ML+1))GO TO 8
C NO TRIPLE-LETTER ACCID. (NATURAL)
ML=ML+1
KQ=1300
C TYPE AA FOR AF, AAA = AS, AAAA = AN
GO TO 610
66 K=NALF(N)
IF(N.GT.0)GO TO 7
C JUMP IF NOT A LETTER
KQ=1300
C ; ***** NOTES ***** =1000 2ND DIG=ACCI.
IF(K.EQ.22)GO TO 610
C CAIE =22 ;*** CAN USE 'V' FOR NATURAL(EASIER TO HIT!!)
IF(K.EQ.14)GO TO 610
C CAIN =14 ; --N-- = 13300 IF(K.EQ.14)GO TO 610
C JRST S610 ; 13500 C JUMP IF NATURAL
IF(K.EQ.19)GO TO 8
C CAIN =19 ; -- S -- = 13400 IF(K.EQ.19)GO TO 8
C JRST S8
88 KQ=1100
C IT'S A FLAT
GO TO 610
8 KQ=1200
C SHARP =1200
610 ML=ML+1
NK=INP(ML)
K=NALF(NK)
IF(NK.GE.0)GO TO 7
C SKIPL INP-1(ML) ;IF CHAR. ISN'T A LETTER, GO TO S7
C JRST S7 ; (LETTERS ARE NEG., NUMBS ARE POS.)
IF(K.NE.19)GO TO 777
C CAIE =19 ;IF(K.EQ.19) THEN IT'S SS
C JRST .+3 ;FOR DBL FLAT, DBL SHARP
KQ=1500
C DBL FLAT
GO TO 610
777 IF(K.NE.6)GO TO 7
C CAIE 6 ;IS IT 'FF'?
C JRST S7
KQ=1400
C FF=1400, SS=1500
GO TO 610
C GO BACK FOR ANOTHER CHAR.
7 IF(K.EQ.11)GO TO 5410
C IS IT 'K'?
IF(K.LT.0)GO TO 5410
C IF SEMICOLON OR BLANK
IF(K.NE.24)GO TO 24
C IS IT 'X'?
GO TO 5410
24 JSCA=K-1
C SAVE OCT. NUM
ML=ML+1
GO TO 2410
5410 IF(NSWCH.EQ.0)GO TO 2410
7410 JJ=NOLD-NNUM
IF(JJ.GE.4)JSCA=JSCA+1
C CAIL JJ,4 ; 15920 IF(JJ.LT.4)GO TO 377
C AOS JSCA
IF(JJ.LE.0)JSCA=JSCA-1
C CAMG JJ,[-4] ; 16010 377 IF(JJ.GT.-4)GO TO 2410
C SOS JSCA
C WILL JUMP TO NEAREST NOTE (DIATONIC-'75)
2410 JJ=1
VX2=0
QQ=JSCA*7+NNUM+KQ
C MOVE 2,JSCA ;VX1=(1000+ACCI*100+OCT*7+NNUM)*DBST
C IMULI 2,7 ADD 2,NNUM
C ADD 2,QQ ; ADD 1000+OCT*7 (QQ)
C FLTR 2,2
VX(1)=QQ*DBST
C FMPR 2,DBST
C MOVEM 2,VX ; 16500 C DOUBLE STOPS ARE NEG. NUMBERS
NOLD=NNUM
CC;; ?S4410: MOVNI NNUM,2 ;16700 4410 NNUM=-2
4410 IF(INP(ML).EQ.ISEMI)GO TO 773
C ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
GO TO 310
210 JJ=JJ+1
IF(JJ.EQ.1)GO TO 3310
XMINUS=1.
VX(JJ)=0
C 'X N1,N2' MAY REPLACE 'REP N1,N2'. N2=0 BECOMES N2=2
GO TO 310
C JUMP IF A LETTER
S1410: MOVE MODE ; 17900 1410 IF(N.NE.'-')GO TO 14
CAME N,LMI
JRST S544
MOVN XMINUS,[1.0] ; 18000 XMINUS=-1.
JUMPE JJ,S2799 ; IF(JJ.EQ.0)GO TO 2799 -- FOR '-BA' ETC.
CAIN 1
JRST S644 ; IF(MODE.EQ.1)GO TO 644 [FOR AUTO OCT. SYS.]
JRST S2799 ; 18100 GO TO 2799
S544: CAIN 1 ; IF(N.NE.'+')GO TO 14
CAME N,LPL
JRST S14
S644: MOVSI 7,203700 ; [7.0] DEFAULT IS OCTAVE. (+ OR - 7)
JSA 16,NALF
JUMP ALF-1(ML) ;THE NEXT CHARACTER.
CAIG =9
SKIPG
JRST S744 ;NEXT IS NOT A NUMB.
FLTR 7,0 ;MOVE 7,0
AOJ ML,
S744: CAME N,LPL
MOVNS 7
MOVEM 7,VX4 ; SEND IT TO SCMSS -- AT 71
JRST S2799
; 18102 144 TRIP=0
S144: SETZM TRIP
; 18105 444 IF(K.EQ.8)VX1=2
S444: CAIE =8
JRST .+3
MOVSI 2,202400
JRST SVX
CAIE 4 ;18107 IF(K.EQ.4)VX1=.5
JRST .+3
MOVSI 2,200400
JRST SVX
CAIE 5 ; 18110 IF(K.EQ.5)VX1=8
JRST .+3
MOVSI 02,204400
JRST SVX
CAIE 7 ; 18115 IF(K.EQ.7)VX1=88
JRST .+3
MOVSI 02,207540
JRST SVX
CAIE =19 ; 18120 IF(K.EQ.19)VX1=16
JRST .+3
MOVSI 02,205400
JRST SVX
CAIE =20 ; 18125 IF(K.NE.20)GO TO 244
JRST S244
MOVSI 02,204600 ; 18126 VX1=12
MOVE N,INP -1(ML) ; 18127 N=INP(ML)
CAME N,LBL ; 18129 IF(N.EQ.LBL)GO TO 344
CAMN N,ISEMI
;; JRST S344 ; 18131 IF(N.EQ.ISEMI)GO TO 344
JRST SVX
CAIE N,1 ;IF(N.EQ.1)GO TO SVX (DOT WAS CHANGED TO 1)
CAMN N,IXX ; IF(N.EQ.IXX)GO TO SVX
JRST SVX
MOVSI TRIP,576400 ; 18133 TRIP=-1
AOS ML ; 18150 ML=ML+1
JSA 16,NALF ; 18155 K=NALF(N)
JUMP N
MOVE N,INP-1(ML) ; N=INP(ML) *******
JRST S444 ; 18160 GO TO 444
S244: CAIE =23 ; 18220 244 IF(K.EQ.23)VX1=1
JRST .+3
MOVSI 02,201400
JRST .+4
CAIE =17 ; 18222 IF(K.EQ.17)VX1=4
JRST .+3
MOVSI 02,203400
SVX: MOVEM 02,VX ; 18223 C TS=24TH, TQ=6, TH=3.
; FOR S,E,Q,H,W,D,T RHYTH. 'T'(K=20) =TRIPLET D=DBL WHL NOTE
JUMPGE TRIP,S344 ;18225 IF(TRIP)VX1=VX1*1.5
MOVSI 2,201600
FMPRM 02,VX
S344: AOS JJ ; 18226 344 JJ=JJ+1
JRST S1310
S14: SETOM ISKP ; 18230 14 ISKP=-1
CAME N,DOT ; 18300 IF(N.NE.'.')GO TO 79
JRST S79
MOVE DECI,M ; 18400 DECI=M
JRST S75
S79: AOS M ; 18600 79 M=M+1
JSA 16,NALF ;18700 IQ(M)=NALF(N)
JUMP N
MOVEM 00,IQ -1(M)
S75: CAMN N,ISEMI ;18900 75 IF(N.EQ.ISEMI)GO TO 751
JRST S751
MOVEI 02,1 ; 18950 IF(INP(ML).NE.1)GO TO 2799
CAME 02,INP -1(ML)
JRST S2799
S751: JUMPE ISKP,SEND ; 19000 751 IF(ISKP.EQ.0)RETURN
S202: CAME DECI,[-1] ; 19100 202 IF(DECI.NE.-1)GO TO 302
JRST S302
SETZM DECI ; 19200 DECI=0
JRST S402
S302: SUB DECI,M ; 19400 302 DECI=M-DECI
MOVNS DECI ; 19500 402 RRN=0
S402: SETZM RRN# ; 19600 REXP=M-1
MOVNI 02,1
ADD 02,M
FLTR 2,2 ;TLC 2,232000
;; FADR 2,2
MOVEM 2,REXP ; 19700 IF(M.LT.1)M=1
CAIGE M,1
MOVEI M,1 ; 19800 DO 171 K=1,M
MOVEI QQ,1 ;USE QQ FOR INDEX
; 19900 IF(REXP.GT.1)GO TO 1
S171: MOVSI 02,201400
CAMGE 02,REXP
JRST S1 ; 20000 RRV=10
MOVSI 02,204500 ; RRV IS IN 2
SKIPN REXP ; 20100 IF(REXP.EQ.0)RRV=1
MOVSI 02,201400
JRST S11 ; 20300 1 RRV=10.**REXP
S1: MOVSI 02,204500
MOVE 03,REXP
PUSHJ 17,EXP3.2 ;20400 11 RRN=RRN+IQ(K)*RRV
S11: FLTR 3,IQ-1(QQ) ;MOVE 3,IQ-1(QQ)
FMPR 2,3
FADRM 2,RRN ; 20500 171 REXP=REXP-1
MOVSI 02,576400
FADRM 02,REXP
CAMGE QQ,M
AOJA QQ,S171
JUMPE DECI,.+6
FLTR DECI,DECI ;TLC DECI,232000
MOVSI 02,204500 ; 20600 A=10.**DECI
MOVE 03,DECI
PUSHJ 17,EXP3.2 ; A WILL BE IN AC2
SKIPA ; 20700 IF(DECI.EQ.0)A=1.
MOVSI 02,201400 ; 20800 JJ=JJ+1
AOS JJ ; 20900 VX(JJ)=RRN/A*XMINUS
MOVE 1,RRN
FDVR 1,2
FMPR 1,XMINUS
MOVEM 1,VX -1(JJ) ; 21000 JN=-JN
MOVNS 00,JN ;21100 C SETS IT TO -1 FOR L,R,U,D EDIT ROUTINE
MOVEI 02,2 ; 21200 IF(MODE.NE.2)XMINUS=1.
CAME 02,MODE
MOVMS XMINUS ; 21300 C************: MODE #?
; 21400 C ONLY ONE - NEEDED FOR RHY.COMPOSITE
S1310: MOVEI 3,1 ; 21500 1310 IF(INP(ML).NE.1)GO TO 310
CAME 3,INP -1(ML)
JRST S310 ;21600 VX(JJ+1)=VX(JJ)*2. ; FOR DOTTED RHYTHMS
;; MOVE 02,VX -1(JJ)
;; FSC 02,1
;; MOVEM 02,VX (JJ) ; 21700 JJ=JJ+1
;; AOS JJ ; 21800 ML=ML+1
MOVE 2,[1000.0] ;VX(JJ)=VX(JJ)+1000
FADRM 2,VX-1(JJ) ;1000 IS ADDED FOR EACH DOT. NO MORE COMPOSITES!!
AOS ML
JRST S1310 +1 ; 22000 206 ML=ML+2
S206: ADDI ML,2 ; 22100 3310 VX(1)=-99.
S3310: MOVN 02,[99.0]
MOVEM 02,VX ; 22200 310 ISKP=0
S310: SETZM ISKP ; 22300 IF(N.NE.ISEMI)GO TO 999
CAME N,ISEMI
JRST S999 ; 22500 RETURN
SEND: MOVEM ML,ALF+=72
MOVEM JJ,SC+=9
JRA 16,(16) ; 22600 73 JJ=JJ+1
S73: AOS JJ ; 22650 K=INP(ML)
MOVE K,INP -1(ML) ;22700 IF(K.EQ.'E')GO TO 206
CAMN K,LE
JRST S206 ; NEXT IS FOR A REST/R/ OR /RI/ FOR INVIS. REST
CAMN K,LD ; 22810 IF(K.EQ.'D')GO TO 1073
JRST S1073
; /RD/ OR /RU/ = REST 6 DOWN OR 6 UP.
CAMN K,LU ; 22830 IF(K.EQ.'U')GO TO 1173
JRST S1173 ; 22900 IF(K.EQ.'I')GO TO 573
CAMN K,LI
JRST S573 ; 22910 IF(K.EQ.'W')GO TO 273
CAMN K,LW
JRST S273
; /RW/ MAKES WHOLE REST REGARDLESS OF TIME VALUE GIVEN.
CAMN K,LR ;IF(K.EQ.'R')GO TO 1273
JRST S1273 ; /RR/ MAKES REPEAT BAR SIGN (REST=-4)
; *** ADD NUMBERS LATER *****; 22932 K=NALF(K)
JSA 16,NALF
JUMP K ; 22934 IF(K)GO TO 673
JUMPL K,S673 ; 22936 IF(K.GE.10)GO TO 673
CAIL =10
JRST S673 ; 22940 973 KV=NALF(INP(ML+1))
S973: MOVE 15,K
JSA 16,NALF
JUMP INP(ML)
; FOR 3-DIG. NUMBS. CAN TAKE NUM UP TO 999 FOR RESTS.
; 22942 IF(KV)GO TO 873
JUMPL S873 ;22944 IF(KV.GE.10)GO TO 873
CAIL =10
JRST S873 ; 22945 ML=ML+1
AOS ML ; 22946 K=K*10+KV
IMULI 15,=10
IMUL 02,K
ADD 15,K ; 15 IS K FOR NOW AND K IS IV
JRST S973+1
S873: ADDI 15,=2000 ; QQ IS AC15 NOW. RW =2002
MOVNS 15
FLTR 15,15 ;TLC 15,232000
JRST S473
S673: MOVSI 15,213764 ;QQ=2000
JRST S373 ;ORDINARY REST
S573: MOVE 15,[2001.0] ;INVISIBLE REST
JRST S473
S273: MOVE 15,[2002.0] ;WHOLE REST (NO MATTER WHAT RHYTH.]
S473: AOS ML ; 22990 473 ML=ML+1
S373: MOVEM 15,VX-1(JJ) ; 23000 373 VX(JJ)=QQ
JRST S4410
S1073: MOVSI 15,213765 ;RD = REST DONW 2004
JRST S473
S1173: MOVE 15,[2005.0] ;RU = REST UP 2005
JRST S473
S1273: MOVE 15,[2003.0] ;RR = BAR REPEAT SIGN
JRST S473 ; FOR /RR/
;23400 END
LNEND: 0 ;SEE FORTR. TEXT IN WORDS.F4
SETZ 4, ;IF BAD INPUT PUT ISEMI INTO ALF(4) [INP1] AT END
MOVE 0,LST ; * SCX+7
MOVE 1,SCX+=9 ; ;
;; MOVE 2,SCN+4 ; /
MOVE 2,LSL ; /
SETZ 3, ;AC3=0
MOVEI 5,=71
;;; MOVEI 3,=71
L2901: CAME 2,ALF(3)
JRST L2903
MOVE 4,3 ;AC4=AC3
;;; MOVEM 1,ALF(3)
JRST L2902 ;GO TO L2902
;;; JRA 16,(16)
L2903: CAME 1,ALF(3)
JRST L2902
MOVEM 0,ALF(3)
JRA 16,(16)
;;;L2902: SKIPLE 3
L2902: AOJ 3,
CAMG 3,5
JRST L2901
MOVEM 1,ALF(4) ;GET LOC. OF LAST /
;;; SOJA 3,L2901
JRA 16,(16)
STFNUM: 0 ;FUNCTION STFNUM(STAFF)
SETOM SCXNR# ;SCXNR=-1 FLAG
SETZ 6,
STFN1: MOVE 2,INP(6)
MOVE 4,INP+1(6)
CAME 2,LS ;IS INP1='S'?
JRST NONUM
CAME 4,LTT ; IF(INP(2).EQ.'T')STAFF=NEXT NUM
CAMN 4,LP ; IS IT A P?
;; CAME 4,[ASCIZ/T /] ; IF(INP(2).EQ.'T')STAFF=NEXT NUM
;; CAMN 4,[ASCIZ/P /] ; IS IT A P?
SKIPA
JRST NONUM ;NO
MOVE 3,LZ ;PUT Z'S INTO FIRST LOCS.
;; MOVE 3,[ASCIZ/Z /] ;PUT Z'S INTO FIRST LOCS.
MOVE ML,6 ;ML=3+PTR
ADDI ML,3
MOVSI XMINUS,201400
MOVE 2,INP+2(6) ;LOOK AT 3RD CHAR.
CAME 2,LMI ;IS IT MINUS?
JRST .+3
MOVNS XMINUS
AOJ ML, ;ML=ML+1
JSA 16,NALF ;GET THE STAFF NUM.
JUMP INP-1(ML)
FLTR
FMPR XMINUS
CAME 4,LP ;IF NOT 'P' GO TO STFN2
;; CAME 4,[ASCIZ/P /] ;IF NOT 'P' GO TO STFN2
JRST STFN2
SETOM SCX+=30 ;RB=-1
MOVEM RMOD+1 ;SET4 IS NOW FILLED
JRST STFN3-1
STFN2: SETZM SCX+=30 ;RB=0
MOVEM @(16) ;TYPE STn/ TO SET STAFF NUM FOR ENTIRE LINE.
MOVE ML,6
STFN3: MOVE 2,INP(ML) ;LOOK FOR THE SLASH AND THROW ALL AWAY
MOVEM 3,INP(ML) ;SKIP UNTIL SEMI (CHANGED FROM SLASH AT S899)
AOJ ML,
CAME 2,LSL
JRST STFN3
SETZM SCXNR ;RETURN A ZERO
MOVE 6,ML
JRST STFN1 ;GO BACK AND LOOK FOR MORE.
NONUM: MOVE SCXNR ;NO STAFF NUM, RETURN A -1
JRA 16,1(16)
END